home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / XLISP 2.0 / XLISP Tools / Utility (UL) / SEQUENCE.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1988-04-07  |  2.0 KB  |  68 lines  |  [TEXT/ttxt]
  1. ;; Larry Mulcahy 1988
  2. ;; sequence functions
  3.  
  4. (provide 'sequence)
  5. (require 'array)
  6. (require 'string-primitive "str-prim")
  7. (require 's-expression-primitive "sexprim")
  8.  
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10. ; concatenate 
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12.  
  13. (defun concatenate (type &rest args)
  14.   (case type
  15.     (string (apply #'strcat args))
  16.     (array (apply #'concatenate-vectors args))
  17.     (cons (apply #'append args))))
  18.  
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20. ; elt 
  21. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22.  
  23. (defun elt (s i)
  24.   (case (type-of s)
  25.     (cons (nth i s))
  26.     (string (char s i))
  27.     (array (aref s i))))
  28.  
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30. ; position 
  31. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32.  
  33. (defun position (e s)
  34.   (case (type-of s)
  35.     (cons (list:position e s))
  36.     (string (string:position e s))
  37.     (array (vector:position e s))))
  38.     
  39. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  40. ; position-if 
  41. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42.  
  43. (defun position-if (test s)
  44.   (case (type-of s)
  45.     (cons (list:position-if test s))
  46.     (string (string:position-if test s))
  47.     (array (vector:position-if test s))))
  48.  
  49. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  50. ; position-if-not 
  51. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  52.  
  53. (defun position-if-not (test s)
  54.   (case (type-of s)
  55.     (cons (list:position-if-not test s))
  56.     (string (string:position-if-not test s))
  57.     (array (vector:position-if-not test s))))
  58.  
  59. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  60. ; substitute 
  61. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  62.  
  63. (defun substitute (new old s &key (test #'eql))
  64.   (case (type-of s)
  65.     (string (string:substitute new old s :test test))
  66.     (cons (subst new old s :test test))
  67.     ))
  68.